#!/usr/bin/perl

our $VERSION = "0.09.00";

use strict;
use warnings;

use Net::XMPP;
use Net::Jaiku;
use Data::Dumper;
use Encode;
use Storable;
use Carp;

my $owner          = 'rickmeasham@jabber.org.au';

my $debug          = 1;  # Output to STDOUT
my $verbose        = 1;  # Output to $owner

my $max_users      = 40;
my $max_tracks     = 40;

my $im_server      = 'jabber.org';
my $im_port        = '5222';
my $im_username    = ''            || $ARGV[0];
my $im_password    = ''            || $ARGV[1];
my $im_resource    = 'bot';

my $jaiku_username = ''            || $ARGV[2];
my $jaiku_password = ''            || $ARGV[3];


# === THE LINE ========================================================
#
# Only cross here if you know what you're doing
#
# =====================================================================


my (%tracker, %reverse_tracker, %prefs);

if(-r 'tracku.store'){
	my $data = retrieve('tracku.store');
	if($data){
		%tracker = $data->{tracker}
			? %{$data->{tracker}}
			: ();
		%prefs = $data->{prefs}
			? %{$data->{prefs}}
			: ();
	}

	# clean up tracker keys with spaces
	for my $k ( keys %tracker ){
		my $clean_k = $k;
		$clean_k =~ s/\s+$//;
		$clean_k =~ s/^\s+//;
		if($k =~ /^\s|\s$/){
			print "Cleaned [$k] to [$clean_k]\n";
			foreach (keys %{ $tracker{$k} }){
				$tracker{$clean_k}{$_} = $tracker{$k}{$_}
			}
			delete $tracker{$k};
		}
	}

	# build the reverse_tracker
	%reverse_tracker = ();
	for my $k ( keys %tracker ){
		foreach (keys %{ $tracker{$k} }){
			$reverse_tracker{$_}{$k} = 1
		}
	}

}

# Make sure we always hit the Stop
$SIG{HUP}  = \&Stop;
$SIG{KILL} = \&Stop;
$SIG{TERM} = \&Stop;
$SIG{INT}  = \&Stop;

my $Connection = new Net::XMPP::Client( debuglevel => $debug );

my $jaiku = new Net::Jaiku(
	username => $jaiku_username,
	userkey  => $jaiku_password,
);

$Connection->SetCallBacks(
	message  => \&InMessage,
	presence => \&InPresence,
	iq       => \&InIQ
);

my $status = $Connection->Connect(
	hostname => $im_server,
	port     => $im_port
);

if (!(defined($status))){
    print "ERROR:  Jabber server is down or connection was not allowed.\n";
    print "        ($!)\n";
    exit(0);
}

my @result = $Connection->AuthSend(
	username => $im_username,
	password => $im_password,
	resource => $im_resource
);

if ($result[0] ne "ok"){
    print "ERROR: Authorization failed: $result[0] - $result[1]\n";
    exit(0);
}

print "Logged in to $im_server:$im_port...\n";

print "Getting Roster to tell server to send presence info...\n";

ROSTER: {
	my %Roster = $Connection->RosterGet();

	my (%potential_delete, %dont_delete);

	# deal with status updates we might not know about
	foreach my $user ( keys %Roster ){

		#printf( "%s ### %s\n", scalar localtime, Dumper $Roster{$user} );

		(my $short_user = $user) =~ s|/.+$||;


		# No subscription in the roster means we want to delete this person
		if($Roster{$user}{subscription} eq 'none' || $Roster{$user}{subscription} eq 'to'){

			printf( "%s --< %s\n", scalar localtime, $user );
			$Connection->Subscription(
				type => "unsubscribed",
				to   => $user
			);

			$Connection->Roster->remove($user);

			$potential_delete{$short_user} = ();

		#	printf "POTENTIALLY DELETING %d KEYS FROM %s (%s)\n", scalar keys %{$reverse_tracker{$short_user}}, $short_user, $user;

		}

		# If someone tried subscribing while we weren't here, lets update
		elsif($Roster{$user}{subscription} eq 'from'){

			# User has us, we want them .. if there's room

			if( keys %reverse_tracker < $max_users ){

				say(
					to   => $user,
					body => qq|Welcome to tracku. Please say 'help' to get a command list|
				);

				printf( "%s ++< %s\n", scalar localtime, $user );
				$Connection->Subscription(
					type => "subscribed",
					to   => $user
				);

				$reverse_tracker{$short_user} ||= {};
				$dont_delete{ $short_user } = ();

		#		printf "STOPPING DELETING %d KEYS FROM %s (%s)\n", scalar keys %{$reverse_tracker{$short_user}}, $short_user, $user;

			}

			# There's no room
			else {

				say(
					to   => $user,
					body => qq|This service is limited to just $max_users users. We're full already sorry|
				);

				printf( "%s --< %s\n", scalar localtime, $user );
				$Connection->Subscription(
					type => "unsubscribed",
					to   => $user
				);
				$Connection->Roster->remove($user);

			}

		} else {
			$dont_delete{ $short_user } = ();
#			printf "STOPPING DELETING %d KEYS FROM %s (%s)\n", scalar keys %{$reverse_tracker{$short_user}}, $short_user, $user;
		}

	}

	foreach my $short_user ( keys %potential_delete ) {
		next if exists $dont_delete{ $short_user };

#		delete( $reverse_tracker{$short_user} );
		foreach( keys %tracker ){
			printf "DELETING %s FROM %s\n", $_, $short_user;
#			delete( $tracker{$_}{$short_user} );
		}
	}
}


print "Sending presence to tell world that we are logged in...\n";

$Connection->PresenceSend();

my %seen;

while(1){
	my $rv = $Connection->Process(30);
	last if(! defined($rv));

	my $feed;
	eval{
		$feed = $jaiku->getFeed();
	};

	if($feed){
		my @stream = @{ $feed->stream };

		foreach my $s (@stream){

			next if $seen{ $s->id }++;

			my %say = ();

			foreach my $t (keys %tracker){

				next if $t =~ /^block:/;

				my $match = 0;

				if( $s->location && (my $rx = $t) =~ s|loc(ation)?:|| ) {
					$match++ if $s->location =~ /\b\Q$rx\E\b/i;
				}
				elsif( $s->icon && ($rx = $t) =~ s|icon:|| ) {
					$match++ if $s->icon =~ /\b\Q$rx\E\b/i;
				}
				elsif( ($rx = $t) =~ s|^/(.+)/i?$|$1| ) {
					$rx = qr/$t/;
					$match++ if $s->title =~ /$rx/;
				}
				elsif( $s->title =~ /\b\Q$t\E\b/i ){
					$match++
				}

				if($match){
					foreach my $u (keys %{$tracker{$t}}){

						next if $reverse_tracker{$u}{'block:' . lc $s->user->nick};

						$say{ $u .'|'. $s->id } ||= {
							to   => $u,
							body => sprintf(
								q|Saw '%s' from %s: %s (%s)|,
								$t,
								$s->user->nick,
								encode('utf8', $s->title),
								$s->url,
							),
							raw_xml => sprintf(
								q|<html xmlns='http://jabber.org/protocol/xhtml-im'><body xmlns='http://www.w3.org/1999/xhtml'>Saw &apos;%s&apos; from <a href='%s'>%s</a>: <a href='%s'>%s</a></body></html>|,
								encode_entities($t),
								$s->user->url,
								encode_entities($s->user->nick),
								$s->url,
								encode_entities( encode('utf8', $s->title ) ),
							)
						}

					}

				}

			}

			foreach (values %say){
				say( %{$_} )
			}

		}

	}

}

print "ERROR: The connection was killed...\n";

exit(0);


sub encode_entities {
	my $data = shift;

	if (defined($data))
	{
#       encode_entities( $data );
		$data =~ s/&/&amp;/g;
		$data =~ s/</&lt;/g;
		$data =~ s/>/&gt;/g;
		$data =~ s/\"/&quot;/g;
		$data =~ s/\'/&apos;/g;
	}

	return $data;
}

sub Stop {
    print "Exiting...\n";

	store_data();

    $Connection->Disconnect();
    exit(0);
}

sub store_data {
	store {
		tracker         => \%tracker,
		prefs           => \%prefs,
	}, 'tracku.store';
}

sub InMessage {
    my $sid = shift;
    my $message = shift;

    my $type = $message->GetType();
    my $fromJID = $message->GetFrom("jid");
	# print $message->GetXML(),"\n";

	return unless $message->DefinedBody();

	(my $from = lc $message->GetFrom) =~ s|/[^/]*$||;

	my $inbody = encode('utf8', $message->GetBody());

	printf( "%s <<< %s: %s\n", scalar localtime, $from, $inbody );



	# Have to make sure we're already introduced
	return unless exists $reverse_tracker{$from};

    my ($command, $body) = split(/\s+/, $inbody, 2);

	$command =~ s/[^a-z]//ig;
	$body ||= '';

	print "Got command: [$command]\n";

	if(lc $command eq 'track'){

		if( scalar keys %{$reverse_tracker{$from}} < $max_tracks ){

			my $ok = 1;

			s/^\s+//, s/\s+$// for $body;

			if($body =~ /i(?:con)?:([a-z]+)/){
				$ok = exists($Net::Jaiku::iconByName{ $1 }) ? 1 : 0;

				if(! $ok){
					say(
						to   => $from,
						body => "Unknown icon name: $1. Please type 'icons' to get the list.",
					);
				}
			}

			if($ok){
				$tracker{lc $body}{$from}++;
				$reverse_tracker{$from}{lc $body}++;

				say(
					to   => $from,
					body => "Tracking $body",
				);
				say(
					to   => $owner,
					body => "Tracking $body for $from",
				) if $verbose;
			}
		} else {
			say(
				to   => $from,
				body => "This system has a limit of $max_tracks tracks or blocks per user",
			);
		}
		store_data();
	}


	elsif(lc $command eq 'untrack'){

		delete $tracker{lc $body}{$from};
		if( delete $reverse_tracker{$from}{lc $body} ){
			say(
				to   => $from,
				body => "Removed $body",
			);
			say(
				to   => $owner,
				body => "Removed $body for $from",
			) if $verbose;
		} else {
			say(
				to   => $from,
				body => "Unable to find $body in your tracks"
			);
		}

		store_data();
	}


	elsif(lc $command eq 'block'){

		if( scalar keys %{$reverse_tracker{$from}} < $max_tracks ){

			if ($body){
				$reverse_tracker{$from}{'block:'. lc $body}++;
				$tracker{'block:'. lc $body}{$from}++;

				say(
					to   => $from,
					body => "Blocking $body",
				);
				say(
					to   => $owner,
					body => "Blocking $body for $from",
				) if $verbose;
			} else {
				say(
					to   => $from,
					body => "The 'block' command requires a Jaiku username for whom you do not wish to see Jaikus",
				);
			}
		} else {
			say(
				to   => $from,
				body => "This system has a limit of $max_tracks tracks or blocks per user",
			);
		}
		store_data();
	}


	elsif(lc $command eq 'unblock'){

		if( delete $reverse_tracker{$from}{'block:'.lc $body} ){
			say(
				to   => $from,
				body => "Unblocked $body",
			);
			say(
				to   => $owner,
				body => "Unblocked $body for $from",
			) if $verbose;
		} else {
			say(
				to   => $from,
				body => "Unable to find $body in your blocks"
			);
		}

		store_data();
	}


	elsif(lc $command eq 'icons'){

		say(
			to   => $from,
			body =>"Icons\n" . join("\n", map { "$_: " . join(", ", map { $Net::Jaiku::iconById{$_} } @{ $Net::Jaiku::iconsByCategory{$_} } ) } keys %Net::Jaiku::iconsByCategory ),
			#TODO raw_xml
		);
	}

	elsif(lc $command eq 'list'){

		my @tracks = grep { ! m|^block:| } keys %{$reverse_tracker{$from}};
		my @blocks = grep {   m|^block:| } keys %{$reverse_tracker{$from}};

		if (@tracks || @blocks){

			my $tracks = @tracks
				? "You are tracking '" . join("', '", sort @tracks) . "'. "
				: '';

			my $blocks = @blocks
				? "You are blocking '" . join("', '", sort map { s/^block://; $_ } @blocks) . "'."
				: '';

			say(
				to   => $from,
				body => "$tracks$blocks",
			);
		}
		else {
			say(
				to   => $from,
				body => "You are not tracking anything.",
			);
		}
	}


	elsif(lc $command eq 'help'){

		say(
			to   => $from,
			body =>"Commands:
track keyword: lets you know when anyone mentions 'keyword' in the public stream
track loc:keyword: lets you know when anyone posts from a location that matches 'keyword'
track icon:iconname: lets you know when anyone posts using the given icon (see list icons)
untrack keyword: stops tracking 'keyword' (same for untrack loc:keyword and icon:iconname)
block jaiku-username: never get notified about jaikus from 'jaiku-username'
unblock jaiku-username: removes the above block
list: lists all your current tracks
list icons: lists all available icon names
version: gets the version of the service",
			raw_xml => q|<html xmlns='http://jabber.org/protocol/xhtml-im'><body xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'><span style="font-weight: bold">Commands</span><br/>
<span style="font-weight: bold">track <em>keyword</em></span><br/>Lets you know when anyone mentions 'keyword' in the public stream<br/>
<span style="font-weight: bold">track loc:<em>keyword</em></span><br/>Lets you know when anyone posts from a location that matches 'keyword'<br/>
<span style="font-weight: bold">track icon:<em>iconname</em></span><br/>Lets you know when anyone posts using the given icon (see list icons)<br/>
<span style="font-weight: bold">untrack <em>keyword</em></span><br/>Stops tracking 'keyword' (same for untrack loc:keyword)<br/>
<span style="font-weight: bold">block <em>jaiku-username</em></span><br/>Never get notified about jaikus from 'jaiku-username'<br/>
<span style="font-weight: bold">unblock <em>jaiku-username</em></span><br/>Removes the above block<br/>
<span style="font-weight: bold">list</span><br/>Lists all your current tracks<br/>
<span style="font-weight: bold">list icons</span><br/>Lists all available icon names<br/>
<span style="font-weight: bold">version</span><br/>Get the version of the service<br/></body></html>|,
		);

	}

	elsif(lc $command eq 'version'){

		say(
			to   => $from,
			body =>"tracku v$VERSION [$$]. For more information see the googlecode project: http://tracku.googlecode.com/",
			raw_xml => qq|<html xmlns='http://jabber.org/protocol/xhtml-im'><body xmlns='http://www.w3.org/1999/xhtml'><strong>tracku v$VERSION</strong> [$$] For more information see <a href="http://tracku.googlecode.com/">the googlecode project</a></body></html>|
		)

	}

	elsif( lc $command eq 'who' && $from eq $owner ){

		say(
			to   => $from,
			body => Dumper( \%reverse_tracker )
		)

	}

	elsif( lc $command eq 'restart' && $from eq $owner ){

		say(
			to   => $from,
			body => "restarting"
		);

		exit;

	}

	elsif( lc $command eq 'broadcast' && $from eq $owner ){

		foreach ( keys %reverse_tracker ){
			say(
				to   => $_,
				body => "Broadcast message: $body"
			);
		}

	}

	elsif( lc $command eq 'status' && $from eq $owner ){

		my ($status) = split(/\s+/, $body);
		$status ||= 'available';

		$Connection->PresenceSend( type => $status);

		say(
			to   => $from,
			body => "Set presence to $status"
		);


	}

	elsif( lc $command eq 'unsubscribe' && $from eq $owner ){

		my ($who) = split(/\s+/, $body);

		$Connection->Subscription(
			type => "unsubscribed",
			to   => $who
		);

		$Connection->Roster->remove($who);

		delete $reverse_tracker{$who};
		foreach ( keys %tracker ){
			delete $tracker{$_}{$who}
		}

	}

	elsif( lc $command eq 'roster' && $from eq $owner ){

		my %Roster = $Connection->RosterGet();

		foreach my $user ( keys %Roster ){

			say(
				to => $owner,
				body => Dumper( $Roster{$user} )
			);

		}

	}

	elsif( lc $command eq 'verbose' && $from eq $owner ){

		$verbose = $body ? 1 : 0;
		say(
			to => $owner,
			body => "Set verbose to $verbose",
		);

	}

	elsif( lc $command eq 'ping' ){

		say(
			to => $from,
			body => "Plain Pong",
			raw_xml => q|<html xmlns='http://jabber.org/protocol/xhtml-im'><body xmlns='http://www.w3.org/1999/xhtml' xml:lang='en'><p>HTML Pong</p></body></html>|
		);

	}
}


sub InIQ {
    my $sid = shift;
    my $iq = shift;

    my $from = $iq->GetFrom();
    my $type = $iq->GetType();
    my $query = $iq->GetQuery();
    my $xmlns = $query->GetXMLNS();
    print "===\n";
    print "IQ\n";
    print "  From $from\n";
    print "  Type: $type\n";
    print "  XMLNS: $xmlns\n";
    print "===\n";
    print $iq->GetXML(),"\n";
    print "===\n";
}

sub InPresence {
    my $sid = shift;
    my $presence = shift;

    my $from = $presence->GetFrom();
    my $type = $presence->GetType();
    my $status = $presence->GetStatus();

    print "===\n";
    print "Presence\n";
    print "  From $from\n";
    print "  Type: $type\n";
    print "  Status: $status\n";
    print "===\n";
    print $presence->GetXML(),"\n";
    print "===\n";

	if($type eq 'subscribe'){

		if( keys %reverse_tracker < $max_users ){

			(my $from = lc $presence->GetFrom) =~ s|/[^/]*$||;

			if( ! exists $reverse_tracker{$from} ){

				say(
					to   => $from,
					body => qq|Welcome to tracku. Please say 'help' to get a command list|
				);

				$reverse_tracker{$from} = {};

#				print "Accepting ".$presence->GetFrom()."\n\n\n";
				printf( "%s ++< %s\n", scalar localtime, $from );

				$Connection->Subscription(
					type => "subscribed",
					to   => $from
				);

#				print "\n\nAdding ".$presence->GetFrom()."\n\n\n";
				printf( "%s ++> %s\n", scalar localtime, $from );

				$Connection->Subscription(
					type => "subscribe",
					to   => $presence->GetFrom()
				);

			}

			else { # we already know them!
				say(
					to   => $from,
					body => qq|You're already subscribed. Please say 'help' to get a command list|
				);
			}
		}
		else {
			say(
				to   => $presence->GetFrom(),
				body => qq|This service is limited to just $max_users users. We're full already sorry|
			);

			$Connection->Subscription(
				type => "unsubscribed",
				to   => $presence->GetFrom()
			);

		}
	}
}

sub say {
	my %arg = @_;
	if(! $arg{to}){
		croak("Missing argument 'to' to 'say'");
	}
	if(! ($arg{body} || $arg{raw_xml})){
		croak("Missing argument 'body' or 'raw_xml' to 'say'");
	}

	printf( "%s >>> %s: %s\n", scalar localtime, $arg{to}, $arg{body} || $arg{raw_xml} );

	my $raw_xml = delete($arg{raw_xml});


	my $message = new Net::XMPP::Message();

	$message->SetMessage( %arg );

	if($raw_xml){
		$message->InsertRawXML( $raw_xml );
	}

	$Connection->Send( $message );
}
